Справочное руководство по TDMS 5.0 API
VB Script
Смотри также Послать замечания

Glossary Item Box

Исходный код

Option Explicit
Call EditFile(ThisObject, "FILE_EXCEL", CreateObject("Excel.Application"))


'==============================================================================
' Добавить к объекту копию шаблонного файла Excel, и открыть его на редактирование
'==============================================================================
Sub EditFile(Obj, FDefSysName, ExcelApp)
        Dim FDef, FDefs, FTemplate, Doc, ObjFiles, FName , NewObjFile
    
        'Проверить что там с Excelem
        If ExcelApp Is Nothing Then
                MsgBox "Ошибка открытия Excel.", vbExclamation
                Exit Sub
        End If    

        On Error Resume Next
        
        'Если типов файлов с указанным системным именем не найдено, выйти из процедуры
        Set FDefs = ThisApplication.FileDefs
        If Not FDefs.Has(FDefSysName) Then Exit Sub
        
        'Получить ссылку на заданный тип файла
        Set FDef = FDefs(FDefSysName)
        If FDef.Templates.Count=0 Then
                MsgBox "Шаблонов для типа файла " & FDefSysName & " не найдено.", vbInformation
                Exit Sub
        End If
        
        'Получить ссылки на первый шаблонный файл данного типа и коллекцию файлов объекта
        Set FTemplate = FDef.Templates(0)
        Set ObjFiles = Obj.Files
        
        'Задать имя, под которым файл будет добавлен...
        FName = FDefSysName & "_test.xls"
        
        'Если файл с таким именем уже в коллекции, запросить другое имя у пользователя
        If ObjFiles.Has(FName) Then
                While ObjFiles.Has(FName)
                            FName = InputBox("Введите другое имя файла (такое уже есть в коллекции):",, FName)
                Wend                
        End If
        
        'Разрешить любому пользователю
        Obj.Permissions = SysAdminPermissions
        
        'Добавить копию шаблонного файла в коллекцию файлов объекта (метод Add в данном случае
        'использовать нельзя, он работает только с динамическими коллекциями файлов)
        Set NewObjFile = ObjFiles.AddCopy(FTemplate, FName)
        
        'Открыть файл объекта на редактирование
        NewObjFile.CheckOut NewObjFile.WorkFileName
        Set Doc = ExcelApp.Workbooks.Open(NewObjFile.WorkFileName)
        ExcelApp.Cells(1,1).Value = Obj.GUID
        ExcelApp.Visible = True
        
        'Если была ошибка, сообщить об этом и главное - выйти из Excelя, а то процесс так и 
        'останется висеть в системе
        If Err<>0 Then
                ExcelApp.Quit
                MsgBox "Ошибка добавления файла к объекту."_
                        & Chr(13) &    "Код ошибки: " & Err, vbExclamation     
        End If
End Sub
'==============================================================================
© 2016 CSoft Development. Все права защищены.